home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / GRAPHICS / IMGLIB95 / UMAIL.PA_ / UMAIL.PA
Text File  |  1996-03-31  |  8KB  |  286 lines
  1. {
  2. Written by Jan Dekkers and Kevin Adams (c) 1995, 1996. If you are a non
  3. registered client, you may use or alter this demo only for evaluation
  4. purposes.
  5.  
  6. Copyright by SkyLine Tools. All rights reserved.
  7.  
  8. Part of Imagelib VCL/DLL Library.
  9. }
  10.  
  11. unit Umail;
  12.  
  13. {Includes settings to compile in either 16 or 32 bit}
  14. {$I DEFILIB.INC}
  15.  
  16. interface
  17.  
  18. uses
  19. {$IFDEF DEL32}
  20.   Windows,
  21. {$ELSE}
  22.   WinTypes,
  23.   WinProcs,
  24. {$ENDIF}
  25.   DLL95V1,    {ImageLib Dll interface and misc. functions}
  26.   SysUtils,
  27.   Messages,
  28.   Classes,
  29.   Graphics,
  30.   Controls,
  31.   Forms,
  32.   Dialogs,
  33.   ExtCtrls,
  34.   DBCtrls,
  35.   MPlayer,
  36.   StdCtrls,
  37.   DB,
  38.   DBTables,
  39.   Gauges,
  40.   Mask,
  41.   Buttons,
  42.   Spin,
  43.   Tdmultim, Tdmultip;   {PDBMultiMedia1, PDBMultiImage VCL component}
  44.  
  45. type
  46.   TMailOrderForm = class(TForm)
  47.     DataSource1: TDataSource;
  48.     Table1: TTable;
  49.     DBMultiImage1: TPDBMultiImage;
  50.     DBMultiMedia1: TPDBMultiMedia;
  51.     DBMemo1: TDBMemo;
  52.     DBMultiImage2: TPDBMultiImage;
  53.     AddMM: TBitBtn;
  54.     AddImage: TBitBtn;
  55.     AddMsg: TBitBtn;
  56.     BitBtn6: TBitBtn;
  57.     DBEdit1: TDBEdit;
  58.     DBEdit2: TDBEdit;
  59.     Gauge1: TGauge;
  60.     Gauge2: TGauge;
  61.     OpenDialog1: TOpenDialog;
  62.     DBMediaPlayer1: TPDBMediaPlayer;
  63.     SpinButton1: TSpinButton;
  64.     DBNavigator1: TDBNavigator;
  65.     BitBtn1: TBitBtn;
  66.     CheckBox1: TCheckBox;
  67.     procedure FormCreate(Sender: TObject);
  68.     procedure AddImageClick(Sender: TObject);
  69.     procedure AddMMClick(Sender: TObject);
  70.     procedure DataSource1DataChange(Sender: TObject; Field: TField);
  71.     procedure AddMsgClick(Sender: TObject);
  72.     procedure SpinButton1DownClick(Sender: TObject);
  73.     procedure SpinButton1UpClick(Sender: TObject);
  74.     procedure BitBtn1Click(Sender: TObject);
  75.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  76.     procedure CheckBox1Click(Sender: TObject);
  77.   private
  78.     { Private declarations }
  79.     Procedure Trigger(Sender : TObject; Var Done : Boolean);
  80.   public
  81.     { Public declarations }
  82.   end;
  83.  
  84. var
  85.   MailOrderForm: TMailOrderForm;
  86.  
  87. implementation
  88.  
  89. {$R *.DFM}
  90.  
  91. {---------------------------------------------------------------------}
  92. {IMPORTANT}
  93. {Changed in version 2.21 from a procedure to a function with cdecl.
  94.  To cancel return a 0 else return a 1}
  95.  
  96. Function MMCalledBack ( i : integer) : integer; cdecl; export;
  97. {Callback function from the dll, CDECL and EXPORT ARE REQUIRED}
  98. begin
  99.  
  100.   if Application.Terminated then
  101.  
  102.    {User wants to terminate the program. Pass a 0 to the dll}
  103.    Result:=0
  104.  
  105.   else begin
  106.    {Process Progress bar}
  107.    if MailOrderForm <> Nil then
  108.     MailOrderForm.Gauge1.Progress:=i;
  109.  
  110.    {Live in peace with others}
  111.    Application.ProcessMessages;
  112.  
  113.    {tell the dll that everything is OK}
  114.    Result:=1;
  115.    end;
  116. end;
  117. {---------------------------------------------------------------------}
  118.  
  119. {IMPORTANT}
  120. {Changed in version 2.21 from a procedure to a function with cdecl.
  121.  To cancel return a 0 else return a 1}
  122.  
  123. Function MICalledBack ( i : integer) : integer; cdecl; export;
  124.  
  125. {Callback function from the dll, CDECL and EXPORT ARE REQUIRED}
  126. begin
  127.  
  128.   if Application.Terminated then
  129.  
  130.    {User wants to terminate the program. Pass a 0 to the dll}
  131.    Result:=0
  132.  
  133.   else begin
  134.    {Process Progress bar}
  135.    if MailOrderForm <> Nil then
  136.      MailOrderForm.Gauge2.Progress:=i;
  137.  
  138.    {Live in peace with others}
  139.    Application.ProcessMessages;
  140.  
  141.    {tell the dll that everything is OK}
  142.    Result:=1;
  143.    end;
  144. end;
  145. {---------------------------------------------------------------------}
  146.  
  147. Procedure TMailOrderForm.Trigger(Sender : TObject; Var Done : Boolean);
  148. begin
  149.     {IMPORTANT}
  150.    {This function is called when your app is idle. Subdivide the
  151.     trigger event to your TDBMultiMedia objects who may need one.
  152.     If no Message is active it will not take up significant time}
  153.     DBMultiMedia1.Trigger;
  154.     DBMultiImage1.Trigger;
  155.     DBMultiImage2.Trigger;
  156. end;
  157. {---------------------------------------------------------------------}
  158.  
  159.  
  160. procedure TMailOrderForm.FormCreate(Sender: TObject);
  161. begin
  162.     {Register the callback Fuctions to the VCL}
  163.     TPDBMultiMediaCallBack:=MMCalledBack;
  164.     TPDBMultiImageCallBack:=MICalledBack;
  165.  
  166.     If FileExists(ExtractFilePath(Application.ExeName)+'MAIL_ORD.DB') then begin
  167.        {if the table exists open it on creation}
  168.        Table1.DataBaseName:=ExtractFilePath(Application.ExeName);
  169.        Table1.TableName:='MAIL_ORD.DB';
  170.        Table1.Active:=True;
  171.      end;
  172.  
  173.    {IMPORTANT}
  174.     {This is the moving engine for all the messages. Since an applcation
  175.     can have only one OnIdle Trigger, this trigger needs to be subdivided
  176.     by all your moving and animated objects. In this particular case the
  177.     function is called TRIGGER but you can name it as you want as long
  178.     you have a procedure named the same.}
  179.     Application.OnIdle:=Trigger;
  180.  end;
  181. {---------------------------------------------------------------------}
  182.  
  183. procedure TMailOrderForm.AddImageClick(Sender: TObject);
  184. begin
  185.   OpenDialog1.filter:='All Images|*.png;*.jpg;*.bmp;*.gif;*.pcx|Png|*.png|Jpeg|*.jpg|BitMap|*.bmp|Gif|*.gif|Pcx|*.pcx';
  186.   {Execute the open dialog box}
  187.   if OpenDialog1.Execute then begin
  188.  
  189.     Table1.Edit;
  190.  
  191.     {Load the Multimedia into the Blob}
  192.     DBMultiImage2.LoadfromFile(OpenDialog1.FileName);
  193.  
  194.     {Post that thing}
  195.     Table1.Post;
  196.   end;
  197. end;
  198. {---------------------------------------------------------------------}
  199.  
  200. procedure TMailOrderForm.AddMMClick(Sender: TObject);
  201. begin
  202.   {fill the OpenDialog filter with the MM extensions as found in the win.ini
  203.    (This means that the appropriate drivers are installed)}
  204.   OpenDialog1.filter:=GetMultiMediaExtensions;
  205.  
  206.   {Execute the open dialog box}
  207.   if OpenDialog1.Execute then begin
  208.  
  209.     Table1.Edit;
  210.  
  211.     {Load the Multimedia into the Blob}
  212.     DBMultiMedia1.LoadfromFile(OpenDialog1.FileName);
  213.  
  214.     {Post that thing}
  215.     Table1.Post;
  216.   end;
  217. end;
  218. {---------------------------------------------------------------------}
  219.  
  220. procedure TMailOrderForm.DataSource1DataChange(Sender: TObject; Field: TField);
  221. begin
  222.     {Set the Video display rectangle to the rectangle of the blob window}
  223.     DBMediaPlayer1.DisplayRect:=Rect(0,0,DBMultiMedia1.Width,DBMultiMedia1.Height);
  224.  
  225.     {Set the Video display to the the display of the blob window}
  226.     DBMediaPlayer1.Display:=DBMultiMedia1;
  227.  
  228. end;
  229. {---------------------------------------------------------------------}
  230.  
  231. procedure TMailOrderForm.AddMsgClick(Sender: TObject);
  232. begin
  233.     Table1.Edit;
  234.     {Create a New Message}
  235.     If DBMultiImage1.CreateMessage then
  236.     {Post or cancel that thing}
  237.        Table1.Post
  238.     else
  239.        Table1.Cancel;
  240. end;
  241. {---------------------------------------------------------------------}
  242.  
  243. procedure TMailOrderForm.SpinButton1DownClick(Sender: TObject);
  244. begin
  245.   if DBMultiImage1.MsgSpeed <10 then Inc(DBMultiImage1.MsgSpeed)
  246. end;
  247. {---------------------------------------------------------------------}
  248.  
  249. procedure TMailOrderForm.SpinButton1UpClick(Sender: TObject);
  250. begin
  251.   if DBMultiImage1.MsgSpeed >0 then Dec(DBMultiImage1.MsgSpeed)
  252. end;
  253. {---------------------------------------------------------------------}
  254.  
  255. procedure TMailOrderForm.BitBtn1Click(Sender: TObject);
  256. begin
  257.     {Place the Database in Edit mode}
  258.     Table1.Edit;
  259.     {Create a New Credit Message}
  260.     If DBMultiMedia1.CreateCreditMessage then
  261.     {Post or cancel that thing}
  262.       Table1.Post
  263.     else
  264.       Table1.Cancel;
  265. end;
  266. {---------------------------------------------------------------------}
  267.  
  268. procedure TMailOrderForm.CheckBox1Click(Sender: TObject);
  269. begin
  270.      DBMultiImage2.Stretch:=CheckBox1.Checked;
  271. end;
  272. {---------------------------------------------------------------------}
  273.  
  274. procedure TMailOrderForm.FormClose(Sender: TObject;
  275.   var Action: TCloseAction);
  276. begin
  277.     Application.OnIdle:=Nil;
  278.     {UNRegister the callback Fuctions to the VCL}
  279.     TPDBMultiMediaCallBack:=Nil;
  280.     TPDBMultiImageCallBack:=Nil;
  281.     MailOrderForm:=Nil;
  282.     Action:=caFree;
  283. end;
  284.  
  285. end.
  286.